home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pull5x.zip / PULLSTAT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-01  |  30KB  |  756 lines
  1. { =========================================================================== }
  2. { PullStat.pas - User Statistics for pull-down menus.      ver 5.Xa, 01-11-89 }
  3. {                                                                             }
  4. { This file contains all the data for GetUserPullStats, GetOverrideStats and  }
  5. { CheckGlobalKeys to configure the menus.                                     }
  6. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  7. { =========================================================================== }
  8.  
  9. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  10. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  11.  
  12. {$define UseSubMenuCode }
  13. {$define UseHelpWndwCode }
  14. {$define UseDataEntryCode }
  15. {$define UseMsgLineCode }
  16.  
  17. UNIT PullStat;
  18.  
  19. INTERFACE
  20.  
  21. uses
  22.   Crt,Qwik,Wutil,Wndw,Pull,PullDir;
  23.  
  24. { ------------------ Set up your window names here in order: ---------------- }
  25. { This is optional, but it sure helps you in not only understanding the
  26.   program, but also makes it unquestionably easier to rearrange.              }
  27.  
  28. type
  29.   MainMenuNames = (NoMainMenu,FilesMenu,ColorMenu,AutoPartsMenu,EnterDataMenu,
  30.                    OptionsMenu,UtilitiesMenu,IRSmenu,QuitMenu);
  31.  
  32.   {$ifdef UseSubMenuCode }
  33.   SubMenuNames  = (NoSubMenu,TiresMenu,RadioMenu,UpdateMenu,DateMenu,
  34.                    BrandsMenu);
  35.   {$endif }
  36.  
  37.   {$ifdef UseDataEntryCode }
  38.   DataWndwNames = (NoDW,BytesDW,WordsDW,IntegersDW,LongIntsDW,RealsDW,HexDW,
  39.                    CharsDW,StringsDW,PathDW,FileMaskDW,SeatsDW,PriceDW,MonthDW,
  40.                    DayDW,YearDW,YearsDW);
  41.   {$endif }
  42.  
  43.   {$ifdef UseHelpWndwCode }
  44.   HelpWndwNames = (NoHW,WorkWndwHW,TopLineHW,FilesMenuHW,DirMenuHW,
  45.                    BrandsMenuHW,EnterDataMenuHW,IRSmenuHW,DateMenuHW,
  46.                    UpdateMenuHW,ExecChoiceHW,SingleChoiceHW,MultipleChoiceHW,
  47.                    NumericHW,TextHW);
  48.   HelpLineNames = (NoHL,               { HL - HelpLine;  L  - Last }
  49.                    HLw1,HLw2,HLw3,HLw4,HLw5,HLw6, { Work window }
  50.                    HLw7,HLw8,HLw9,HLw10,HLwL,
  51.                    HLt1,HLtL,                     { Top menu }
  52.                    HLb1,HLb2,HLb3,HLb4,HLb5,HLbL, { Brands submenu }
  53.                    HLf1,HLf2,HLf3,HLf4,HLf5,      { Files submenu }
  54.                    HLf6,HLf7,HLf8,HLf9,HLfL,
  55.                    HLdir1,HLdir2,HLdir3,HLdir4,HLdir5,  { Directory submenu }
  56.                    HLdir6,HLdir7,HLdir8,HLdir9,HLdirL,
  57.                    HLe1,HLe2,HLe3,HLe4,HLe5,      { Enter data submenu }
  58.                    HLe6,HLe7,HLe8,HLe9,HLe10,
  59.                    HLe11,HLe12,HLe13,HLe14,HLeL,
  60.                    HLi1,HLi2,HLiL,                { IRS menu }
  61.                    HLd1,HLd2,HLd3,HLdL,           { Date submenu }
  62.                    HLu1,HLu2,HLuL,                { Update submenu }
  63.                    HLx1,HLx2,HLxL,                { eXecute choice menu }
  64.                    HLs1,HLs2,HLsL,                { Single choice menu }
  65.                    HLm1,HLm2,HLmL,                { Multiple choice menu }
  66.                    HLn1,HLn2,HLn3,HLn4,HLn5,HLn6,HLnL,       { Numeric data }
  67.                    HLtx1,HLtx2,HLtx3,HLtx4,HLtx5,HLtx6,HLtxL);  { Text data }
  68.   {$endif UseHelpWndwCode }
  69.  
  70.   {$ifdef UseMsgLineCode }
  71.   MsgLineNames = (NoML,WorkML,TopML,AltML,MainML,SubML,DW_ML,DE_ML,
  72.                   SeqML,HelpML,ProcML,DirML);
  73.   {$endif UseMsgLineCode }
  74.  
  75. const
  76.   FileName: string[12] = 'pulldemo.exe';
  77.  
  78. { Careful! - Always test your last main menu, submenu, data window, and help
  79.   window for run-time error!  It makes sure you have allotted enough memory
  80.   with your constants.  The compiler cannot check it with these typed scalars.}
  81.  
  82. procedure GetUserPullStats;
  83. procedure GetOverrideStats;
  84. procedure CheckGlobalKeys;
  85.  
  86.  
  87. IMPLEMENTATION
  88.  
  89. procedure GetMainMenu (Name: MainMenuNames);
  90. begin
  91.   MRI := ord (Name);
  92.   TopMenu := MainMenu^[MRI];
  93. end;
  94.  
  95. procedure SaveMainMenu;
  96. begin
  97.   MainMenu^[MRI] := TopMenu;
  98. end;
  99.  
  100. {$ifdef UseSubMenuCode }
  101. procedure GetSubMenu (Name: SubMenuNames);
  102. begin
  103.   MRI := ord (Name);
  104.   TopMenu := SubMenu^ [MRI];
  105. end;
  106.  
  107. procedure SaveSubMenu;
  108. begin
  109.   SubMenu^[MRI] := TopMenu;
  110. end;
  111. {$endif }
  112.  
  113. {$ifdef UseHelpWndwCode }
  114. procedure SetHelpLines (Name: HelpWndwNames; First,Last: HelpLineNames);
  115. begin
  116.   HelpWndw[ord(Name)].FirstLine := ord(First);
  117.   HelpWndw[ord(Name)].LastLine  := ord(Last);
  118. end;
  119. {$endif }
  120.  
  121. { ============================ EXEC PROCEDURES ============================== }
  122. { Place procedures for execution by menu pointers, ProcPtr, here.             }
  123. { They MUST be set to FAR calls.                                              }
  124. { --------------------------------------------------------------------------- }
  125.  
  126. {$F+}
  127. procedure DummyProc;
  128. begin
  129.   {$ifdef UseMsgLineCode }
  130.   ShowMsg (ord(ProcML));
  131.   {$endif UseMsgLineCode }
  132.   Delay (1000)
  133. end;
  134.  
  135. procedure GotoDir;
  136. begin
  137.   PullDown:=true;
  138.   MoreCmdSeq:='D';
  139. end;
  140.  
  141. procedure DoDir;
  142. begin
  143.   { Use (FileName,FileName) to initially Hilite a close match. }
  144.   { Use (FileName,'') to start at default. }
  145.   PullDirectory (FileName,FileName);
  146. end;
  147.  
  148. procedure SetQuit;
  149. begin
  150.   PopToWorkWndw := true;
  151.   Quit := true;
  152. end;
  153.  
  154. procedure ProcessThenPop;
  155. begin
  156.   { Here's how to process and then pop the menus. }
  157.   DummyProc;
  158.   PopToWorkWndw := true;
  159. end;
  160.  
  161. procedure PopThenProcess;
  162. begin
  163.   { Here's how to pop first and then process. }
  164.   if Popped then DummyProc;
  165. end;
  166.  
  167. procedure PopProcessAndPull;
  168. begin
  169.   { Here's how to pop the menus first, process and then pull the same }
  170.   { menus back again which is good for updating the work window. }
  171.   if Popped then DummyProc;
  172.   PullDown := true;
  173. end;
  174.  
  175. procedure PopNumOfLevels;
  176. begin
  177.   { Here's how to pop by a number of levels so that part of the menus will }
  178.   { remain displayed while going to another submenu. }
  179.   PopLevels  := 1;
  180.   PullDown   := true;
  181.   MoreCmdSeq := 'Y';
  182. end;
  183.  
  184. procedure PopToNewMenu;
  185. begin
  186.   { Here's how to go to a completely different menu. }
  187.   PopToTop   := true;
  188.   PullDown   := true;
  189.   MoreCmdSeq := 'AR';
  190. end;
  191.  
  192. procedure DateMenu1;
  193. begin
  194.   PullDown   := true;
  195.   MoreCmdSeq := 'D';
  196. end;
  197.  
  198. procedure DateMenu2;
  199. begin
  200.   PullDown   := true;
  201.   MoreCmdSeq := 'Y';
  202. end;
  203.  
  204. procedure DateMenu3;
  205. begin
  206.   PopLevels := 1;
  207. end;
  208. {$F-}
  209.  
  210. { ======================== GetUserPullStats ================================= }
  211. { The major configurations for all menus go here.  The program first clears   }
  212. { all RECORD values to $00.  The values below will set new values. Therefore, }
  213. { setting RECORD values to "false" or the like is not necessary.              }
  214. { --------------------------------------------------------------------------- }
  215.  
  216. procedure GetUserPullStats;
  217. begin
  218.   LocationWarning:=true;   { If true and a Submenu won't fit, a message is
  219.                              displayed.  If false, you can override the
  220.                              location without the message. }
  221.  
  222.   { ------------------ Set up your colors and borders here: ---------------- }
  223.   TopLineAttr   := Black+LightGrayBG;
  224.   TopLineHattr  := White+BlackBG;
  225.  
  226.   MainMenuBattr := LightGray+BlackBG;
  227.   MainMenuHattr := Black+LightGrayBG;
  228.   MainMenuLattr := Yellow+BlackBG;
  229.   MainMenuCattr := LightGray+BlackBG;
  230.   Brdr[UserBrdr1].BrdrArray := '╒═╕││└─┘╞═╡╤│┴╪';
  231.   MainMenuBrdr  := UserBrdr1;
  232.  
  233.   {$ifdef UseSubMenuCode }
  234.   SubMenuWattr  := Black+CyanBG;
  235.   SubMenuBattr  := Black+CyanBG;
  236.   SubMenuBrdr   := SingleBrdr;
  237.   {$endif UseSubMenuCode }
  238.  
  239.   if VideoMode=7 then
  240.     begin
  241.       TopLineLattr := TopLineAttr;
  242.       MainMenuWattr:= LightGray+BlackBG;
  243.       {$ifdef UseSubMenuCode }
  244.       SubMenuHattr := Black    +LightGrayBG;
  245.       SubMenuLattr := White    +BlackBG;
  246.       SubMenuCattr := LightGray+BlackBG;
  247.       {$endif UseSubMenuCode }
  248.     end
  249.   else
  250.     begin
  251.       TopLineLattr := Red  +LightGrayBG;
  252.       MainMenuWattr:= White+BlackBG;
  253.       {$ifdef UseSubMenuCode }
  254.       SubMenuHattr := White+BlueBG;
  255.       SubMenuLattr := White+CyanBG;
  256.       SubMenuCattr := Blue +CyanBG;